home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / portwrth.arc / PORTMRKT.BAS < prev    next >
BASIC Source File  |  1983-09-14  |  11KB  |  263 lines
  1. 10 ' PROGRAM NAME: PORTMRKT.BAS   WRITTEN 27 AUG 1983   REV 14 SEP 1983
  2. 20 '
  3. 30 '  *******************************************************************
  4. 40 '
  5. 50  DIM COMP.NAME$(25), QTY(25), PRICE(25), DELTA(25)
  6. 55  DIM TARGET(25)
  7. 60 '
  8. 70 '  *******************************************************************
  9. 80 '  * DRIVER MODULE                                                   *
  10. 90 '  *                                                                 *
  11. 100 ' *******************************************************************
  12. 110 '
  13. 115 CLS
  14. 120 PRINT "PROGRAM PORTMRKT.BAS EXECUTING"
  15. 140 OPEN "A:DRIVE.DTA" FOR INPUT AS #1
  16. 150 INPUT #1, DRIVE$,PRNT$
  17. 160 CLOSE #1
  18. 170 IF DRIVE$ = "A" OR DRIVE$ = "a" THEN GOSUB 300 ELSE GOSUB 400
  19. 180 '
  20. 190 GOSUB 500                           'PRIME READ
  21. 200 '
  22. 210 GOSUB 600                           'DATA READS
  23. 220 '
  24. 230 GOSUB 800                           'INPUT PRICE/DELTA PER SHARE
  25. 235 '
  26. 240 WIDTH "LPT1:",132
  27. 242 '  SET UP DEFAULT CONDITIONS FOR IBM OR EPSON PRINTER
  28. 245 IF PRNT$ = "E" OR PRNT$ = "e" THEN GOSUB 2800 ELSE GOSUB 2900
  29. 248 '
  30. 250 LPRINT CHR$(15);                    'SET COMPRESSED CHAR ON
  31. 255 '
  32. 260 GOSUB 1000                          'PRINT REPORT
  33. 265 '
  34. 270 GOSUB 2200                          'CHECK/CORRECT REPORT OUTPUT
  35. 280 '
  36. 290 GOSUB 2700                          'EOJ HSKEEPING
  37. 295 '
  38. 298 END
  39. 300 ' *******************************************************************
  40. 310 ' * GOSUB 300                                                       *
  41. 320 ' * GET DATA FROM DRIVE A                                           *
  42. 330 ' *******************************************************************
  43. 340 '
  44. 350 PRINT "INSERT DATA DISKETTE IN DRIVE A"
  45. 355 PRINT "SET PRINTER TO TOP OF PAGE"
  46. 360 PRINT "VERIFY THAT PRINTER IS ON"
  47. 365 PRINT "STRIKE ANY KEY WHEN READY"
  48. 370 A$ = INKEY$: IF A$ = "" THEN 370
  49. 380 OPEN "A:HOLDLIST.DTA" FOR INPUT AS #2
  50. 390 RETURN
  51. 400 ' *******************************************************************
  52. 410 ' * GOSUB 400                                                       *
  53. 420 ' * GET DATA FROM DRIVE B                                           *
  54. 430 ' *******************************************************************
  55. 440 '
  56. 450 PRINT "INSERT DATA DISKETTE IN DRIVE B"
  57. 455 PRINT "SET PRINTER TO TOP OF PAGE"
  58. 460 PRINT "VERIFY THAT PRINTER IS ON"
  59. 465 PRINT "STRIKE ANY KEY WHEN READY"
  60. 470 A$ = INKEY$: IF A$ = "" THEN 470
  61. 480 OPEN "B:HOLDLIST.DTA" FOR INPUT AS #2
  62. 490 RETURN
  63. 500 ' *******************************************************************
  64. 510 ' * GOSUB 500                                                       *
  65. 520 ' * PRIME READ MODULE                                               *
  66. 530 ' *******************************************************************
  67. 540 '
  68. 550 INPUT #2, FILE.TITLE$,FILE.OWNER$,RECORD.COUNT,DATE.OF.RECORD$,UPDATE.DATE$
  69. 560 RETURN
  70. 600 ' *******************************************************************
  71. 610 ' * GOSUB 600                                                       *
  72. 620 ' * READ IN ALL INPUT DATA                                          *
  73. 630 ' *******************************************************************
  74. 640 '
  75. 650 FOR N = 1 TO RECORD.COUNT
  76. 660     IF EOF(2) THEN GOTO 740
  77. 670     INPUT #2, INAME$, IQTY, ICOST, ITARGET
  78. 680     COMP.NAME$(N) = INAME$
  79. 690     QTY(N) = IQTY
  80. 700     TARGET(N) = ITARGET
  81. 720     TOTAL.SHARE.COUNT = TOTAL.SHARE.COUNT + IQTY
  82. 730     NEXT
  83. 740 CLOSE #2
  84. 745 N = N - 1
  85. 750 RETURN
  86. 800 ' *******************************************************************
  87. 810 ' * GOSUB 800                                                       *
  88. 820 ' * INPUT CURRENT PRICE/CHANGES PER SHARE                           *
  89. 830 ' *******************************************************************
  90. 840 '
  91. 845 INPUT "INPUT DATE FOR REPORT (DD MONTH YYYY) ", REPORT.DATE$
  92. 850 '
  93. 855 PRINT "INPUT CURRENT PRICE PER SHARE (A)"
  94. 860 PRINT "      AND"
  95. 870 PRINT "      PER SHARE PRICE CHANGE (B)"
  96. 880 PRINT "      FOR FOLLOWING:"
  97. 890 PRINT
  98. 900 '
  99. 910 FOR J = 1 TO N
  100. 920     PRINT COMP.NAME$(J)
  101. 930     INPUT "A = ", PRICE(J)
  102. 940     INPUT "B = ", DELTA(J)
  103. 950     NEXT
  104. 960 '
  105. 970 INPUT "DO YOU WISH TO CORRECT AN INPUT (Y/N)? ", C$
  106. 980 IF C$ = "Y" OR C$ = "y" THEN GOSUB 2500
  107. 990 RETURN
  108. 1000 ' *******************************************************************
  109. 1010 ' * GOSUB 1000                                                      *
  110. 1020 ' * PRINT REPORT                                                    *
  111. 1030 ' *******************************************************************
  112. 1040 '
  113. 1050 GOSUB 1300                         'PRINT HEADERS
  114. 1055 '
  115. 1060 FOR K = 1 TO N
  116. 1070    TTL.DELTA = DELTA(K) * QTY(K)
  117. 1080    TTL.PRICE = PRICE(K) * QTY(K)
  118. 1090    GRND.TTL.DELTA = GRND.TTL.DELTA + TTL.DELTA
  119. 1100    GRND.TTL.PRICE = GRND.TTL.PRICE + TTL.PRICE
  120. 1110    LPRINT TAB(12) USING "##,###"; QTY(K);
  121. 1120    LPRINT TAB(24) COMP.NAME$(K);
  122. 1130    LPRINT TAB(50) USING "###.###"; PRICE(K);
  123. 1140    LPRINT TAB(63) USING "##.###"; DELTA(K);
  124. 1150    LPRINT TAB(75) USING "###,###.##"; TTL.DELTA;
  125. 1160    LPRINT TAB(90) USING "#,###,###.##"; TTL.PRICE;
  126. 1170    LPRINT TAB(108) USING "###.###"; TARGET(K);
  127. 1180    IF PRICE(K) = TARGET(K) OR PRICE(K) > TARGET(K) THEN LPRINT TAB(122) "****" ELSE LPRINT TAB(122) "    "
  128. 1200    NEXT
  129. 1210 '
  130. 1220 GOSUB 1700                         'PRINT TOTALS
  131. 1230 '
  132. 1235 LPRINT CHR$(12);                   'PRINTER HOF COMMAND
  133. 1240 '
  134. 1250 RETURN
  135. 1300 ' *******************************************************************
  136. 1310 ' * GOSUB 1300                                                      *
  137. 1320 ' * PRINT HEADERS                                                   *
  138. 1330 ' *******************************************************************
  139. 1340 '
  140. 1345 LPRINT
  141. 1350 LPRINT: LPRINT
  142. 1355 '                                   HEADER #1
  143. 1360 LPRINT TAB(42) "PORTFOLIO EVALUATION - ";
  144. 1370 LPRINT TAB(65) REPORT.DATE$;
  145. 1380 LPRINT TAB(110) DATE$
  146. 1390 LPRINT
  147. 1395 '                                   HEADER #2
  148. 1400 LPRINT TAB(52) FILE.OWNER$
  149. 1410 LPRINT: LPRINT
  150. 1415 '                                   HEADER #3
  151. 1420 LPRINT TAB(12) "ACCOUNT";
  152. 1430 LPRINT TAB(24) "SECURITY";
  153. 1440 LPRINT TAB(50) "CURRENT";
  154. 1450 LPRINT TAB(62) "PER SHARE";
  155. 1460 LPRINT TAB(78) "TOTAL";
  156. 1465 LPRINT TAB(91) "CURRENT";
  157. 1470 LPRINT TAB(109) "SELL";
  158. 1472 LPRINT TAB(121) "TARGET"
  159. 1475 '                                   HEADER #4
  160. 1480 LPRINT TAB(12) "QUANTITY";
  161. 1485 LPRINT TAB(24) "NAME";
  162. 1490 LPRINT TAB(50) "PRICE";
  163. 1500 LPRINT TAB(63) "CHANGE";
  164. 1510 LPRINT TAB(78) "CHANGE";
  165. 1520 LPRINT TAB(91) "TOTAL VALUE";
  166. 1530 LPRINT TAB(109) "TARGET";
  167. 1540 LPRINT TAB(121) "REACHED"
  168. 1550 LPRINT: LPRINT
  169. 1560 '
  170. 1570 RETURN
  171. 1700 ' *******************************************************************
  172. 1710 ' * GOSUB 1700                                                      *
  173. 1720 ' * PRINT TOTALS                                                    *
  174. 1730 ' *******************************************************************
  175. 1740 '
  176. 1745 '                                  TOTAL LINE 1
  177. 1750 LPRINT:LPRINT
  178. 1770 LPRINT TAB(11) USING "###,###"; TOTAL.SHARE.COUNT;
  179. 1780 LPRINT TAB(24) "TOTALS";
  180. 1785 LPRINT TAB(72) USING "##,###,###.##"; GRND.TTL.DELTA;
  181. 1800 LPRINT TAB(89) USING "##,###,###.##"; GRND.TTL.PRICE
  182. 1840 '
  183. 1850 RETURN
  184. 2200 ' *******************************************************************
  185. 2210 ' * GOSUB 2200                                                      *
  186. 2220 ' * CHECK/CORRECT PRINTED REPORT                                    *
  187. 2230 ' *******************************************************************
  188. 2240 '
  189. 2250 PRINT "CHECK PRINTED REPORT "
  190. 2260 INPUT "DO YOU WISH TO CORRECT AND REPRINT (Y/N)? ", Q$
  191. 2270 IF Q$ <> "Y" AND Q$ <> "y" THEN GOTO 2350
  192. 2280 '
  193. 2290 GOSUB 2500                         'CORRECT INPUTS
  194. 2300 '
  195. 2310 GOSUB 1000                         'PRINT REPORT
  196. 2315 '
  197. 2320 GOTO 2250
  198. 2330 '
  199. 2350 RETURN
  200. 2500 ' *******************************************************************
  201. 2510 ' * GOSUB 2500                                                      *
  202. 2520 ' * CORRECT INPUT                                                   *
  203. 2530 ' *******************************************************************
  204. 2535 '
  205. 2540 GRND.TTL.DELTA = 0
  206. 2545 GRND.TTL.PRICE = 0
  207. 2550 '
  208. 2555 PRINT "INPUT NUMBER OF STOCK TO BE CORRECTED"
  209. 2560 PRINT "      OR"
  210. 2570 PRINT "      0 TO END CORRECTIONS"
  211. 2580 INPUT CORRECTION.NUM
  212. 2590 IF CORRECTION.NUM = 0 THEN GOTO 2685
  213. 2600 IF CORRECTION.NUM < 1 OR CORRECTION.NUM > N THEN BEEP: GOTO 2550
  214. 2610 PRINT COMP.NAME$(CORRECTION.NUM)
  215. 2620 PRINT "ORIGINAL PRICE ENTERED WAS ", PRICE(CORRECTION.NUM)
  216. 2630 INPUT "NEW PRICE TO BE ENTERED IS "; PRICE(CORRECTION.NUM)
  217. 2640 PRINT "ORIGINAL PRICE CHANGE ENTERED WAS ", DELTA(CORRECTION.NUM)
  218. 2650 INPUT "NEW PRICE CHANGE TO BE ENTERED IS "; DELTA(CORRECTION.NUM)
  219. 2660 GOTO 2540
  220. 2670 '
  221. 2680 '
  222. 2685 PRINT "VERIFY THAT PRINTER IS ON"
  223. 2690 RETURN
  224. 2700 ' *******************************************************************
  225. 2710 ' * GOSUB 2700                                                      *
  226. 2720 ' * EOJ HOUSEKEEPING                                                *
  227. 2730 ' *******************************************************************
  228. 2740 '
  229. 2750 PRINT "PROGRAM PROCESSING COMPLETED - PROGRAM ENDS"
  230. 2770 LPRINT CHR$(18);                   'SET COMPRESSED CHAR OFF
  231. 2780 WIDTH "LPT1:",80
  232. 2795 RETURN
  233. 2800 '***********************************************************
  234. 2805 '*   SET EPSON PRINTER TO DEFAULT CONDITION                *
  235. 2810 '***********************************************************
  236. 2815 '
  237. 2820 LPRINT CHR$(27); CHR$(64);         'TURN OFF ALL SPCL PRINTER CODES
  238. 2825 RETURN
  239. 2900 '***********************************************************
  240. 2905 '*   SET IBM PRINTER TO DEFAULT CONDITIONS                 *
  241. 2910 '***********************************************************
  242. 2915 '
  243. 2920 LPRINT CHR$(20);                   'DOUBLE WIDTH CHAR OFF
  244. 2925 LPRINT CHR$(18);                   'COMPRESSED CHAR OFF
  245. 2930 LPRINT CHR$(27); CHR$(50);         'DEFAULT LINE SPACING (1/6")
  246. 2935 LPRINT CHR$(27); CHR$(55);         'CHAR SET #1 SELECTED
  247. 2940 LPRINT CHR$(27); CHR$(57);         'PAPER OUT SWITCH ENABLED
  248. 2945 LPRINT CHR$(27); CHR$(70);         'EMPHASIZED CHAR OFF
  249. 2950 LPRINT CHR$(27); CHR$(72);         'DOUBLE STRIKE OFF
  250. 2955 LPRINT CHR$(27); CHR$(79);         'IGNORE SKIPS OVER PERFS
  251. 2960 LPRINT CHR$(27); CHR$(85); CHR$(0);  'SELECT BIDIRECTIONAL PRINT
  252. 2965 LPRINT CHR$(27); CHR$(84);         'SUB/SUPERSCRIPT OFF
  253. 2970 LPRINT CHR$(27); CHR$(87); CHR$(0);  'DOUBLE WIDE CHAR OFF
  254. 2975 LPRINT CHR$(27); CHR$(45); CHR$(0);  'UNDERLINING OFF
  255. 2980 '
  256. 2985 RETURN
  257. 2990 '
  258. 2995 '***********************************************************
  259. ); CHR$(0);  'UNDERLINING OFF
  260. 2980 '
  261. 2985 RETURN
  262. 2990 '
  263. 2995 '***